home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / klondike2d.srx < prev    next >
Text File  |  2000-02-29  |  3KB  |  148 lines
  1. /**********************************\
  2. ** Klondike2D v1.0 for Solitarexx **
  3. **      by Michal Szafranski      **
  4. \**********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Klondike 2D v1.0"'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDTEXT 4 42 tex 6
  11. ADDCYCLE 7 9 'No|Yes' 0 '"Move parts"' 14
  12. ADDCYCLE 9 12 '"Inf.|Once|Twice|3 Times|4 Times|5 Times|6 Times"' 1 '"Rotate deck"' 16
  13. ADDCYCLE 11 12 '"3-2-1|One|Two|Three"' 1 '"Cards at once"' 17
  14. ADDBUTTON 12 10 "Abort"
  15. ADDTEXT 14 42 tex 6
  16. SELECTGUI 3
  17.  
  18. SCREENSIZE 3 18 9 0
  19. DO i = 0 TO 8
  20.     NEWSTACK 3 16+4 0 i 0 0 0 18
  21.     stack.i = RESULT
  22. END
  23. DO i = 0 TO 3
  24.     NEWSTACK 4 0 i+2 i+5 1 0 18
  25.     base.i = RESULT
  26. END
  27. DO i = 4 TO 7
  28.     NEWSTACK 4 0 i-2 i+1 2 0 18
  29.     base.i = RESULT
  30. END
  31. NEWSTACK 1 0 1 0 1 0 18
  32. deck = RESULT
  33. NEWSTACK 2 32+8+1 1 1 1 0 18 2 2
  34. waste = RESULT
  35. ADDCARDS deck
  36. ADDCARDS deck SHUFFLED
  37.  
  38. DO FOREVER
  39.     ACTION
  40.     PARSE VAR RESULT act rest
  41.     IF act = 1 THEN EXIT
  42.     IF act = 3 THEN CALL GAME
  43. END
  44.  
  45. GAME:
  46.     CLEANUP deck
  47.     SETGADGET 14 STR tex
  48.     SELECTGUI 4
  49.     sel = 0
  50.     time = 0
  51.     fin = 0
  52.     GETGADGET 9
  53.     gadtimes = RESULT
  54.     GETGADGET 11
  55.     gadcards = RESULT
  56.     GETGADGET 7
  57.     moveparts = RESULT
  58.     ile. = 0
  59.     SELECT
  60.         WHEN gadcards = 0 THEN DO
  61.             ile.0 = 3
  62.             ile.1 = 2
  63.             ile.2 = 1
  64.         END
  65.         WHEN gadtimes = 0 THEN ile. = gadcards
  66.         OTHERWISE DO i = 0 TO gadtimes-1
  67.             ile.i = gadcards
  68.         END
  69.     END
  70.     DO i=0 TO 8
  71.         CARDSELECT deck i
  72.         MOVECARDS deck stack.i
  73.         CARDSELECT deck 1
  74.         MOVECARDS deck stack.i REVERSE
  75.     END
  76.     DO FOREVER
  77.         ACTION
  78.         PARSE VAR RESULT act stack sid card
  79.         IF act = 1 THEN EXIT
  80.         IF act = 2 THEN SELECT
  81.             WHEN sid=1 THEN CALL DODECK
  82.             WHEN sel=0 & card>0 & sid~=4 THEN sel = stack
  83.             WHEN sel>0 & (sel = stack | sid = 4) THEN CALL DOBASE
  84.             WHEN sel>0 & sid = 3 THEN CALL DOSTACKS
  85.             OTHERWISE ERRBEEP
  86.         END
  87.         IF act = 3 THEN DO
  88.             SELECTGUI 3
  89.             RETURN
  90.         END
  91.     END
  92. RETURN
  93. DODECK:
  94.     IF sel=waste THEN sel=0
  95.     CARDSELECT deck ile.time
  96.     IF RESULT = '' THEN DO
  97.         CARDSELECT waste 52
  98.         MOVECARDS waste deck REVERSE
  99.         time = time+1
  100.     END
  101.     ELSE MOVECARDS deck waste REVERSE
  102. RETURN
  103. DOSTACKS:
  104.     CARDSELECT sel 0 RELATIVE
  105.     PARSE VAR RESULT kolors wars xx
  106.     IF moveparts = 0 THEN DO
  107.         WHICHCARD sel VISIBLE
  108.         PARSE VAR RESULT len lsel
  109.         IF lsel ~= 1 & lsel ~= len THEN RETURN
  110.     END
  111.     CARDSELECT stack 1
  112.     PARSE VAR RESULT kolor war xx
  113.     IF kolor = '' THEN DO
  114.         war = 13
  115.         kolor = kolors+1
  116.     END
  117.     kolor = (kolor+kolors) // 2
  118.     IF war = wars+1 & kolor = 1 THEN MOVECARDS sel stack ATONCE
  119.     ELSE ERRBEEP
  120.     sel = 0
  121. RETURN
  122. DOBASE:
  123.     IF sel~=stack THEN CALL CHBASE
  124.     ELSE DO i= 0 TO 7 UNTIL ok=0
  125.         stack = base.i
  126.         CALL CHBASE
  127.     END
  128.     IF ok=0 THEN DO
  129.         fin = fin +1
  130.         MOVECARDS sel stack
  131.         IF fin = 104 THEN SETGADGET 14 STR wintex
  132.     END
  133.     ELSE ERRBEEP
  134.     sel = 0
  135. RETURN
  136. CHBASE:
  137.     CARDSELECT sel 1
  138.     PARSE VAR RESULT kolors wars xx
  139.     CARDSELECT stack 1
  140.     PARSE VAR RESULT kolor war xx
  141.     IF kolor = '' THEN DO
  142.         kolor = kolors
  143.         war = -1
  144.     END
  145.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  146.     ELSE ok = 1
  147. RETURN
  148.